﻿unit Modl_HTTP;

interface

uses
  System.SysUtils, System.Classes, rtcInfo, rtcConn, rtcDataSrv, rtcHttpSrv,
  UniConnct,Uni,UniConfig,Class_Memb,qjson,Helpr_UniEngine;

type
  TModlHttp = class(TDataModule)
    HttpSrvr1: TRtcHttpServer;
    RtcDataProvider1: TRtcDataProvider;
    procedure RtcDataProvider1CheckRequest(Sender: TRtcConnection);
    procedure RtcDataProvider1DataReceived(Sender: TRtcConnection);
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
  protected
    procedure OnUniConnctCustomConnectionEventByOBJ(AConnectionMark:string;var OBJA:TUniConfig);
  public
    procedure Start;
    procedure Stop;
  end;

var
  ModlHttp: TModlHttp;
const
  CONST_MARK_YSGL='YSGL';

implementation

uses
  Winapi.ActiveX,Class_KzUtils,Class_Kzdebug;

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}

{ TModlHttp }

procedure TModlHttp.DataModuleCreate(Sender: TObject);
begin
  CoInitialize(nil);
  UniConnctEx.ConnctMode:=cmByOBJ;
  UniConnctEx.OnUniConnctCustomConnectionEventByOBJ:=OnUniConnctCustomConnectionEventByOBJ;
end;

procedure TModlHttp.DataModuleDestroy(Sender: TObject);
begin
  CoUninitialize;
end;

procedure TModlHttp.OnUniConnctCustomConnectionEventByOBJ(
  AConnectionMark: string; var OBJA: TUniConfig);
begin
  OBJA.UnixType:=UniConfig.CONST_PROVIDER_SQLSRV;
  OBJA.UnixUser:='sa';
  OBJA.UnixPswd:='sa';
  OBJA.UnixServ:='.';
  OBJA.DataBase:='DB_YSGL';
end;

procedure TModlHttp.RtcDataProvider1CheckRequest(Sender: TRtcConnection);
begin
  with TRtcDataServer(Sender) do
  begin
    if Request.FileName='/TEST' then
    begin
      Accept;
    end else
    if Request.FileName='/TMEMB.LISTDB' then
    begin
      Accept;
    end else
    if Request.FileName='/TMEMB.INSERTDB' then
    begin
      Accept;
    end;
  end;
end;

procedure TModlHttp.RtcDataProvider1DataReceived(Sender: TRtcConnection);
var
  SQLA:string;
  Data:string;
  TMPA:string;

  List:TCollection;
  JSON:TQJson;
  Memb:TMEMB;

  UniConnct:TUniConnection;
begin
  CoInitialize(nil);
  with TRtcDataServer(Sender) do
  begin
    if Request.Complete then
    begin
      if UpperCase(Request.FileName)='/TEST' then
      begin
        Write('it works.');
      end else
      if UpperCase(Request.FileName)='/TMEMB.LISTDB' then
      begin
        try
          UniConnct:=UniConnctEx.GetConnection(CONST_MARK_YSGL);
          //-<
          SQLA:='SELECT * FROM TBL_MEMB';
          List:=TCollection.Create(TMemb);
          TMEMB.ListDB(SQLA,UniConnct,List);
          JSON:=TQJson.Create;
          JSON.FromRtti(List);
          Write(JSON.ToString);
          FreeAndNil(JSON);
          //->
        finally
          FreeAndNil(UniConnct);
        end;
      end else
      if UpperCase(Request.FileName)='/TMEMB.INSERTDB' then
      begin
        TMPA:=Read;
        Request.Params.AddText(TMPA);
        DATA:=Request.Params.Value['DATA'];

        try
          UniConnct:=UniConnctEx.GetConnection(CONST_MARK_YSGL);
          //-<
          try
            Memb:=TMEMB.Create;
            Memb.ToRtti(Data);
            Memb.MEMBIDEX:=Memb.GetNextIdex(UniConnct);
            Memb.InsertDB(UniConnct);
            Write('Result:=True');
          except

          end;
          //->
        finally
          FreeAndNil(UniConnct);
        end;
      end;
    end;
  end;
  CoUninitialize;
end;

procedure TModlHttp.Start;
begin
  if not HttpSrvr1.isListening  then
  begin
    HttpSrvr1.ServerPort:='8186';
    HttpSrvr1.Listen();
    KzDebug.FileFmt('start listen...at:%S:%S',[HttpSrvr1.ServerAddr,HttpSrvr1.ServerPort]);
  end;
end;

procedure TModlHttp.Stop;
begin

end;

end.
